home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / runtime / sys.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-03  |  5.9 KB  |  292 lines  |  [TEXT/R*ch]
  1. /* Basic system calls */
  2.  
  3. #include <errno.h>
  4. #include <sys/types.h>
  5. #include <fcntl.h>
  6. #include <signal.h>
  7. #include "config.h"
  8. #include "alloc.h"
  9. #include "debugcom.h"
  10. #include "fail.h"
  11. #include "globals.h"
  12. #include "instruct.h"
  13. #include "mlvalues.h"
  14. #include "signals.h"
  15. #include "stacks.h"
  16. #include "io.h"
  17.  
  18. #ifdef HAS_STRERROR
  19.  
  20. extern char * strerror();
  21.  
  22. char * error_message()
  23. {
  24.   return strerror(errno);
  25. }
  26.  
  27. #else
  28.  
  29. extern int sys_nerr;
  30. extern char * sys_errlist [];
  31.  
  32. char * error_message()
  33. {
  34.   if (errno < 0 || errno >= sys_nerr)
  35.     return "unknown error";
  36.   else
  37.     return sys_errlist[errno];
  38. }
  39.  
  40. #endif /* HAS_STRERROR */
  41.  
  42. void sys_error(arg)
  43.      char * arg;
  44. {
  45.   char * err = error_message();
  46.   int err_len = strlen(err);
  47.   int arg_len;
  48.   value str;
  49.  
  50.   if (arg == NULL) {
  51.     str = alloc_string(err_len);
  52.     bcopy(err, &Byte(str, 0), err_len);
  53.   } else {
  54.     arg_len = strlen(arg);
  55.     str = alloc_string(arg_len + 2 + err_len);
  56.     bcopy(arg, &Byte(str, 0), arg_len);
  57.     bcopy(": ", &Byte(str, arg_len), 2);
  58.     bcopy(err, &Byte(str, arg_len + 2), err_len);
  59.   }
  60.   raise_with_arg(SYS_ERROR_EXN, str);
  61. }
  62.  
  63. void sys_exit(retcode)          /* ML */
  64.      value retcode;
  65. {
  66.   flush_stdouterr();
  67.   debugger(PROGRAM_EXIT);
  68.   exit(Int_val(retcode));
  69. }
  70.  
  71. #ifndef O_BINARY
  72. #define O_BINARY 0
  73. #endif
  74. #ifndef O_TEXT
  75. #define O_TEXT 0
  76. #endif
  77.  
  78. static int sys_open_flags[] = {
  79.   O_RDONLY, O_WRONLY, O_RDWR, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
  80.   O_BINARY, O_TEXT
  81. };
  82. #ifdef macintosh
  83. static int sys_text_flags []  = { 0, 0, 0, 0, 0, 0, 0, 0, 1 };
  84. static int sys_write_flags [] = { 0, 1, 1, 0, 0, 0, 0, 0, 0 };
  85. #endif
  86.  
  87. value sys_open(path, flags, perm) /* ML */
  88.      value path, flags, perm;
  89. {
  90.   int ret;
  91. #ifdef macintosh
  92.   extern void set_file_type (char *name, long type);
  93. #if defined(THINK_C) || defined(__MWERKS__)
  94. # define FILE_NAME_SIZE 256
  95.   char filename_temp[FILE_NAME_SIZE];
  96.   char *expanded;
  97.   extern char *unix_to_mac_filename(char *, char *, int);
  98.   expanded = unix_to_mac_filename(String_val(path), filename_temp, FILE_NAME_SIZE);
  99.   if (expanded == NULL)
  100.     ret = -1;
  101.   else
  102.     ret = open(expanded, convert_flag_list(flags, sys_open_flags));
  103.   if ( ret != -1 && convert_flag_list (flags, sys_text_flags)
  104.                    && convert_flag_list (flags, sys_write_flags))
  105.     set_file_type (expanded, 'TEXT');
  106. #else
  107.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags));
  108.   if (ret != -1 && convert_flag_list (flags, sys_text_flags))
  109.     set_file_type (String_val (path), 'TEXT');
  110. #endif
  111. #else
  112.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags),
  113.              Int_val(perm));
  114. #endif
  115.   if (ret == -1) sys_error(String_val(path));
  116.   return Val_long(ret);
  117. }
  118.  
  119. value sys_close(fd)             /* ML */
  120.      value fd;
  121. {
  122.   if (close(Int_val(fd)) != 0) sys_error(NULL);
  123.   return Atom(0);
  124. }
  125.  
  126. value sys_remove(name)          /* ML */
  127.      value name;
  128. {
  129.   int ret;
  130.   ret = unlink(String_val(name));
  131.   if (ret != 0) sys_error(String_val(name));
  132.   return Atom(0);
  133. }
  134.  
  135. value sys_rename(oldname, newname) /* ML */
  136.      value oldname, newname;
  137. {
  138. #ifdef HAS_RENAME
  139.   if (rename(String_val(oldname), String_val(newname)) != 0) 
  140.     sys_error(String_val(oldname));
  141. #else
  142.   invalid_argument("rename: not implemented");
  143. #endif
  144.   return Atom(0);
  145. }
  146.  
  147. value sys_chdir(dirname)        /* ML */
  148.      value dirname;
  149. {
  150.   if (chdir(String_val(dirname)) != 0) sys_error(String_val(dirname));
  151.   return Atom(0);
  152. }
  153.  
  154. extern char * getenv();
  155.  
  156. value sys_getenv(var)           /* ML */
  157.      value var;
  158. {
  159.   char * res;
  160.  
  161.   res = getenv(String_val(var));
  162.   if (res == 0) {
  163.     mlraise(Atom(NOT_FOUND_EXN));
  164.   }
  165.   return copy_string(res);
  166. }
  167.  
  168. value sys_system_command(command)   /* ML */
  169.      value command;
  170. {
  171. #ifdef macintosh
  172.   invalid_argument("system_command unavailable");
  173. #else
  174.   int retcode = system(String_val(command));
  175.   if (retcode == -1) sys_error(String_val(command));
  176.   return Val_int(retcode);
  177. #endif
  178. }
  179.  
  180. static int sys_var_init[] = {
  181.   0400, 0200, 0100,
  182.   0040, 0020, 0010,
  183.   0004, 0002, 0001,
  184.   04000, 02000,
  185.   0444, 0222, 0111
  186. };
  187.  
  188. void sys_init(argv)
  189.      char ** argv;
  190. {
  191.   value v;
  192.   int i;
  193.  
  194.   #ifndef MSDOS
  195.   void init_float_handler();
  196.   init_float_handler();
  197.   #endif
  198.  
  199.   v = copy_string_array(argv);
  200.   modify(&Field(global_data, SYS__COMMAND_LINE), v);
  201.   for (i = SYS__S_IRUSR; i <= SYS__S_IXALL; i++)
  202.     Field(global_data, i) = Val_long(sys_var_init[i - SYS__S_IRUSR]);
  203.   Field(global_data, SYS__INTERACTIVE) = Val_false;
  204.   Field(global_data, SYS__MAX_VECT_LENGTH) = Val_long(Max_wosize);
  205.   Field(global_data, SYS__MAX_STRING_LENGTH) =
  206.     Val_long(Max_wosize * sizeof(value) - 2);
  207. }
  208.  
  209. /* Handling of user interrupts and floating-point errors */
  210.  
  211. #ifndef MSDOS
  212.  
  213. unsigned char raise_break_exn[] = { ATOM, BREAK_EXN, RAISE };
  214.  
  215. sighandler_return_type intr_handler(sig)
  216.      int sig;
  217. {
  218. #ifndef BSD_SIGNALS
  219.   signal (SIGINT, intr_handler);
  220. #endif
  221.   signal_handler = raise_break_exn;
  222.   signal_number = 0;
  223.   execute_signal();
  224. }
  225.  
  226. value sys_catch_break(onoff)    /* ML */
  227.      value onoff;
  228. {
  229.   if (Tag_val(onoff))
  230.     signal(SIGINT, intr_handler);
  231.   else
  232.     signal(SIGINT, SIG_DFL);
  233.   return Atom(0);
  234. }
  235.  
  236. sighandler_return_type float_handler(sig)
  237.      int sig;
  238. {
  239. #ifndef BSD_SIGNALS
  240.   signal (SIGFPE, float_handler);
  241. #endif
  242.   if (float_exn == FAILURE_EXN)
  243.     failwith("floating point error");
  244.   else
  245.     mlraise(Atom(float_exn));
  246. }
  247.  
  248. void init_float_handler()
  249. {
  250.   signal(SIGFPE, float_handler);
  251. }
  252. #endif
  253.  
  254. /* Search path function */
  255.  
  256. #ifndef MSDOS
  257. #ifndef macintosh
  258.  
  259. char * searchpath(name)
  260.      char * name;
  261. {
  262.   static char fullname[512];
  263.   char * path;
  264.   char * p;
  265.   char * q;
  266.  
  267.   for (p = name; *p != 0; p++) {
  268.     if (*p == '/') return name;
  269.   }
  270.   path = getenv("PATH");
  271.   if (path == 0) return 0;
  272.   while(1) {
  273.     p = fullname;
  274.     while (*path != 0 && *path != ':') {
  275.       *p++ = *path++;
  276.     }
  277.     if (p != fullname) *p++ = '/';
  278.     q = name;
  279.     while (*q != 0) {
  280.       *p++ = *q++;
  281.     }
  282.     *p = 0;
  283.     if (access(fullname, 1) == 0) return fullname;
  284.     if (*path == 0) return 0;
  285.     path++;
  286.   }
  287. }
  288.  
  289. #endif
  290. #endif
  291.  
  292.